Predictive Analytics Tool(PAT) Evaluation

This is an R Markdown Notebook that describes the techniques for evaluating the Predictive Analytics Tool and their results. The results from the executed code appear beneath the code itself.

Installing required libraries:

readxl, plotly and ggplot2

options(warn=-1)
require(readxl)
require(plotly)
require(ggplot2)
set.seed(8274)

Importing data for analysis:

Prices, PAT output and Timeline For Client Responses

prices <- read_excel("/Users/shubhankar/Desktop/PRI/prices.xlsx", 1, col_names = TRUE)
pat_output <- read_excel("/Users/shubhankar/Desktop/PRI/PAT_output.xlsx", 1, col_names = TRUE)
client_response_2014 <- read_excel("/Users/shubhankar/Desktop/PRI/TimelineForClientResponses.xlsm", 4, col_names = TRUE)
client_response_2015 <- read_excel("/Users/shubhankar/Desktop/PRI/TimelineForClientResponses.xlsm", 5, col_names = TRUE)
client_response_2016 <- read_excel("/Users/shubhankar/Desktop/PRI/TimelineForClientResponses.xlsm", 6, col_names = TRUE)
client_response_2017 <- read_excel("/Users/shubhankar/Desktop/PRI/TimelineForClientResponses.xlsm", 7, col_names = TRUE)

Basic housekeeping:

Formatting first column as date, setting time-zone.

prices = as.data.frame(prices)
pat_output = as.data.frame(pat_output)
Sys.setenv(tz = Sys.timezone())
invisible(as.POSIXct(prices$Date, tz=getOption("tz")))
invisible(as.POSIXct(pat_output$Date, tz=getOption("tz")))

Plotting calendar year Prices vs Time.

A detailed plot can be viewed here

plot_ly(prices, x = prices$Date, y = prices$Y_14, name = 'Y_14', type = "scatter", mode = 'lines', line = list(width = 1), width = 950) %>%
  add_trace(y = prices$Y_15, name = 'Y_15', mode = 'lines') %>%
  add_trace(y = prices$Y_16, name = 'Y_16', mode = 'lines') %>%
  add_trace(y = prices$Y_17, name = 'Y_17', mode = 'lines') %>%
  add_trace(y = prices$Y_18, name = 'Y_18', mode = 'lines') %>%
  add_trace(y = prices$Y_19, name = 'Y_19', mode = 'lines') %>%
  add_trace(y = prices$Y_20, name = 'Y_20', mode = 'lines') %>%
  add_trace(y = prices$Y_21, name = 'Y_21', mode = 'lines') %>% 
  layout(hovermode="compare")

Plotting AM Prices vs Time.

A detailed plot can be viewed here

plot_ly(prices, x = prices$Date, y = prices$Y_14AM, name = 'Y_14AM', type = "scatter", mode = 'lines', line = list(width = 1), width = 950) %>%
  add_trace(y = prices$Y_15AM, name = 'Y_15AM', mode = 'lines') %>%
  add_trace(y = prices$Y_16AM, name = 'Y_16AM', mode = 'lines') %>%
  add_trace(y = prices$Y_17AM, name = 'Y_17AM', mode = 'lines') %>%
  add_trace(y = prices$Y_18AM, name = 'Y_18AM', mode = 'lines') %>%
  add_trace(y = prices$Y_19AM, name = 'Y_19AM', mode = 'lines') %>%
  add_trace(y = prices$Y_20AM, name = 'Y_20AM', mode = 'lines') %>%
  layout(hovermode="compare")

Plotting distribution of prices for each calendar year and corresponding fiscal year:

Y_14 and Y_14AM, Y_15 and Y_15AM, Y_16 and Y_16AM, Y_17 and Y_17AM, Y_18 and Y_18AM, Y_19 and Y_19AM, Y_20 and Y_20AM, Y_21 and Y_21AM

x_axis_template <- list(showgrid = F,
                      zeroline = F,
                      nticks = 20,
                      showline = T,
                      tick0 = 0,
                      range = c(28,45),
                      title = "Prices")
y_axis_template <- list(nticks = 8, range = c(0,120), title = "Frequency")
strips <- list("Y_14", "Y_15", "Y_16", "Y_17", "Y_18", "Y_19", "Y_20", "Y_21")
plots <- lapply(strips, function(var){
  AM <- paste(var,"AM", sep = "")
  plot_ly(width = 950) %>%
  add_histogram(x = prices[,var], name = var) %>%
  add_histogram(x = prices[,AM], name = AM) %>%
  layout(xaxis = x_axis_template, yaxis = y_axis_template, hovermode="compare")
})
subplot(plots, nrows = 4, shareX = TRUE, shareY = TRUE)

Ignoring 736 observationsIgnoring 695 observationsIgnoring 582 observationsIgnoring 536 observationsIgnoring 351 observationsIgnoring 362 observationsIgnoring 176 observationsIgnoring 183 observationsIgnoring 143 observationsIgnoring 279 observationsIgnoring 279 observationsIgnoring 467 observationsIgnoring 467 observationsIgnoring 719 observationsIgnoring 719 observationsIgnoring 767 observations

Since the number of days of historical data to use in calculations is set to 100 days therefore we skip the prices for first 100 days in each strip and use the subsequent prices to generate recommendations. As a consequence of skipping we are left with no prices for the strip Y_14 and very few entries for the strip Y_14AM. Thus we will consider the prices of strips Y_14AM onwards for evaluating the PAT.

Preliminary Analysis

Split PAT output by respective contract years.

pat_output <- pat_output[order(pat_output$Contract), ]
Y_14AM <- pat_output[pat_output$Contract=="Y_14AM",]
Y_15 <- pat_output[pat_output$Contract=="Y_15",]
Y_15AM <- pat_output[pat_output$Contract=="Y_15AM",]
Y_16 <- pat_output[pat_output$Contract=="Y_16",]
Y_16AM <- pat_output[pat_output$Contract=="Y_16AM",]
Y_17 <- pat_output[pat_output$Contract=="Y_17",]
Y_17AM <- pat_output[pat_output$Contract=="Y_17AM",]

Scatter-line plots showing prices and distribution of hedging opportunities across time for each strip. A red dot represents “5 - Great hedging opportunity” and a yellow dot represents “4 - Very good hedging opportunity”.

#Y_14AM
plotY_14AM <- plot_ly(Y_14AM, x = Y_14AM$Date, y = Y_14AM$Price, name = 'Y_14AM', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 500) %>% layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T)
for(i in Y_14AM[Y_14AM$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_14AM <- add_trace(plotY_14AM, x = (as.numeric(as.Date(Y_14AM[Y_14AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_14AM[Y_14AM$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_14AM <- add_trace(plotY_14AM, x = (as.numeric(as.Date(Y_14AM[Y_14AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}
#Y_15
plotY_15 <- plot_ly(Y_15, x = Y_15$Date, y = Y_15$Price, name = 'Y_15', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 500) %>%
layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T)
for(i in Y_15[Y_15$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_15 <- add_trace(plotY_15, x = (as.numeric(as.Date(Y_15[Y_15$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_15[Y_15$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_15 <- add_trace(plotY_15, x = (as.numeric(as.Date(Y_15[Y_15$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}
#Y_15AM
plotY_15AM <- plot_ly(Y_15AM, x = Y_15AM$Date, y = Y_15AM$Price, name = 'Y_15AM', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 500) %>%
layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T)
for(i in Y_15AM[Y_15AM$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_15AM <- add_trace(plotY_15AM, x = (as.numeric(as.Date(Y_15AM[Y_15AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_15AM[Y_15AM$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_15AM <- add_trace(plotY_15AM, x = (as.numeric(as.Date(Y_15AM[Y_15AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}
#Y_16
plotY_16 <- plot_ly(Y_16, x = Y_16$Date, y = Y_16$Price, name = 'Y_16', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 500) %>%
layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T)
for(i in Y_16[Y_16$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_16 <- add_trace(plotY_16, x = (as.numeric(as.Date(Y_16[Y_16$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_16[Y_16$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_16 <- add_trace(plotY_16, x = (as.numeric(as.Date(Y_16[Y_16$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}
#Y_16AM
plotY_16AM <- plot_ly(Y_16AM, x = Y_16AM$Date, y = Y_16AM$Price, name = 'Y_16AM', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 500) %>%
layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T)
for(i in Y_16AM[Y_16AM$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_16AM <- add_trace(plotY_16AM, x = (as.numeric(as.Date(Y_16AM[Y_16AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_16AM[Y_16AM$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_16AM <- add_trace(plotY_16AM, x = (as.numeric(as.Date(Y_16AM[Y_16AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}
#Y_17
plotY_17 <- plot_ly(Y_17, x = Y_17$Date, y = Y_17$Price, name = 'Y_17', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 500) %>%
layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T)
for(i in Y_17[Y_17$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_17 <- add_trace(plotY_17, x = (as.numeric(as.Date(Y_17[Y_17$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_17[Y_17$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_17 <- add_trace(plotY_17, x = (as.numeric(as.Date(Y_17[Y_17$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}
#Y_17AM
plotY_17AM <- plot_ly(Y_17AM, x = Y_17AM$Date, y = Y_17AM$Price, name = 'Y_17AM', type = "scatter", mode = 'lines', line = list(width = 1), width = 950, height = 450) %>%
layout(hovermode="compare", yaxis = list(title = "Price"), showlegend = T )
for(i in Y_17AM[Y_17AM$Recommendation == "5 - Great hedging opportunity",3]){
  plotY_17AM <- add_trace(plotY_17AM, x = (as.numeric(as.Date(Y_17AM[Y_17AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="red", size=5, opacity=0.5))
}
for(i in Y_17AM[Y_17AM$Recommendation == "4 - Very good hedging opportunity",3]){
  plotY_17AM <- add_trace(plotY_17AM, x = (as.numeric(as.Date(Y_17AM[Y_17AM$Price == i,1])) * 24 * 60 * 60 * 1000), y = i, mode = "markers+lines", showlegend = F, marker = list(color="orange", size=5, opacity=0.5))
}

Y_14AM

plotY_14AM

Y_15

plotY_15

Y_15AM

plotY_15AM

Y_16

plotY_16

Y_16AM

plotY_16AM

Y_17

plotY_17

Y_17AM

plotY_17AM

Violin plots showing price density and distribution of hedging opportunities across prices for each strip. Thicker the plot higher the frequency of the prices in that neighborhood. A red dot represents “5 - Great hedging opportunity” and a yellow dot represents “4 - Very good hedging opportunity”. Horizontal crossbar(black) shows the median price for that strip.

ggplot(width = 950, pat_output, aes(Contract, Price)) + geom_violin(aes(fill = Contract)) + scale_fill_manual(values=c("#B4E0D2", "#FCC6B3", "#C6CFE4", "#F2C5E0", "#D3EAAD", "#FEEBA1", "#F1E1CA")) + geom_point(data=pat_output[pat_output$Recommendation=="5 - Great hedging opportunity",], aes(Contract, Price), color = "#B40619", position = position_jitter(0.09), size = 0.5) + geom_point(data=pat_output[pat_output$Recommendation=="4 - Very good hedging opportunity",], aes(Contract, Price), color = "#E56621", position = position_jitter(0.09), size = 0.5) + stat_summary(fun.y = "median", fun.ymin ="median", fun.ymax ="median", geom ="crossbar", width=0.2, fatten = 1)

Boxplot showing median, first, second, third and fourth quartile of prices for each strip.

box1 <- plot_ly(pat_output, x = ~Contract, y = ~Price, color = ~Contract, type = "box", boxpoints = FALSE, width = 950) %>%
  layout(hovermode="compare")
hedge_price_boxplot <- data.frame(Contract = pat_output[pat_output$Recommendation == "5 - Great hedging opportunity" | pat_output$Recommendation == "4 - Very good hedging opportunity", "Contract"], Price = pat_output[pat_output$Recommendation == "5 - Great hedging opportunity" | pat_output$Recommendation == "4 - Very good hedging opportunity", "Price"])
box2 <- plot_ly(hedge_price_boxplot, x = hedge_price_boxplot$Contract, y = hedge_price_boxplot$Price, color = ~Contract, type = "box", boxpoints = FALSE, width = 950) %>%
  layout(hovermode="compare", title = "Boxplot of all prices(left) Vs. Prices of Great & V. Good Hedge opportunities(right)", showlegend = F)
subplot(box1, box2, shareY = T)

Gather some basic statistics about the PAT output

year_strips <- list(Y_14AM, Y_15, Y_15AM, Y_16, Y_16AM, Y_17, Y_17AM)
fraction <- function(strip){
  yearOrderedByPrice <- strip[order(-strip$Price),]
  first_quartile <- yearOrderedByPrice[c(1:trunc(nrow(yearOrderedByPrice)/4)),]
  second_quartile <- yearOrderedByPrice[c((trunc(nrow(yearOrderedByPrice)/4)+1):trunc(nrow(yearOrderedByPrice)/2)),]
  third_quartile <- yearOrderedByPrice[c((trunc(nrow(yearOrderedByPrice)/2)+1):trunc(nrow(yearOrderedByPrice)*3/4)),]
  fourth_quartile <- yearOrderedByPrice[c((trunc(nrow(yearOrderedByPrice)*3/4)+1):trunc(nrow(yearOrderedByPrice))),]
  
  numOfGreatInFirstQuartile <- sum(first_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInFirstQuartile <- sum(first_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfGreatInSecondQuartile <- sum(second_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInSecondQuartile <- sum(second_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfGreatInThirdQuartile <- sum(third_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInThirdQuartile <- sum(third_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfGreatInFourthQuartile <- sum(fourth_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInFourthQuartile <- sum(fourth_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfOppInFirstQuartile <- numOfGreatInFirstQuartile + numOfVeryGoodInFirstQuartile
  numOfOppInSecondQuartile <- numOfGreatInSecondQuartile + numOfVeryGoodInSecondQuartile
  numOfOppInThirdQuartile <- numOfGreatInThirdQuartile + numOfVeryGoodInThirdQuartile
  numOfOppInFourthQuartile <- numOfGreatInFourthQuartile + numOfVeryGoodInFourthQuartile
  cat("Total no. of Great or V. Good hedging opportunities for the strip",strip$Contract[1],":",numOfOppInFirstQuartile + numOfOppInSecondQuartile + numOfOppInThirdQuartile + numOfOppInFourthQuartile, "\n" )
  cat("No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip",strip$Contract[1],":",numOfOppInFirstQuartile, "\n")
  cat("No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip",strip$Contract[1],":",numOfOppInSecondQuartile, "\n")
  cat("No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip",strip$Contract[1],":",numOfOppInThirdQuartile, "\n")
  cat("No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip",strip$Contract[1],":",numOfOppInFourthQuartile, "\n\n")
  
}
for(i in year_strips){
  fraction(i)
}

Total no. of Great or V. Good hedging opportunities for the strip Y_14AM : 5 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_14AM : 2 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_14AM : 3 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_14AM : 0 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_14AM : 0 

Total no. of Great or V. Good hedging opportunities for the strip Y_15 : 12 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_15 : 0 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_15 : 0 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_15 : 2 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_15 : 10 

Total no. of Great or V. Good hedging opportunities for the strip Y_15AM : 10 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_15AM : 3 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_15AM : 0 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_15AM : 0 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_15AM : 7 

Total no. of Great or V. Good hedging opportunities for the strip Y_16 : 68 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_16 : 7 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_16 : 29 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_16 : 6 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_16 : 26 

Total no. of Great or V. Good hedging opportunities for the strip Y_16AM : 66 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_16AM : 5 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_16AM : 28 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_16AM : 19 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_16AM : 14 

Total no. of Great or V. Good hedging opportunities for the strip Y_17 : 47 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_17 : 11 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_17 : 12 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_17 : 3 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_17 : 21 

Total no. of Great or V. Good hedging opportunities for the strip Y_17AM : 69 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_17AM : 20 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_17AM : 9 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_17AM : 8 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_17AM : 32 

Evaluating PAT

To evaluate PAT more realistically we calculate weighted average prices by incorporating delays in client response time. We use two approaches to calculate the weighted averages:

1) Averaged all at once: Number of client responses for each date are summed together and divided by total number of client responses.

\[ Average\,client\,responses\,on\,\,k^{th}\,\,day\,=\,\frac{\sum(Client\,responses\,on\,k^{th}\,day\,for\,each\,date)}{\sum(Number\,of\,client\,responses\,for\,each\,date)} \]

allStripsPricelist <- list()
for(year in year_strips){
  opportunity_dates <- with(year, Date[year$Recommendation == "5 - Great hedging opportunity" | year$Recommendation == "4 - Very good hedging opportunity"])
  allpricelist <- list()
  for(i in opportunity_dates){
    #print(as.character(as.Date(as.POSIXct(i, origin="1970-01-01"))))
    #print(Y_14AM[Y_14AM$Date==i, "Price"])
    opportunity_index <- which(year$Date == i)
    opportunity_price <- year[opportunity_index, "Price"]
    if(opportunity_index+nrow(client_responses) < (nrow(year)+1)){
      pricelist <- list(year[opportunity_index:(opportunity_index+nrow(client_responses)-1), "Price"])
      names(pricelist) <- as.character(as.Date(as.POSIXct(i, origin="1970-01-01")))
    }
    else{
      pricelist <- list(year[opportunity_index:nrow(year), "Price"])
      names(pricelist) <- as.character(as.Date(as.POSIXct(i, origin="1970-01-01")))
    }
    allpricelist <- append(allpricelist, pricelist)
  }
  allStripsPricelist <- append(allStripsPricelist, allpricelist)
}
avg_client_responses <- list(rowMeans(client_responses))
averaged_prices <- list()
for(i in 1:length(allStripsPricelist)){
  frac <- list((c(avg_client_responses[[1]][1:length(allStripsPricelist[[i]])]))/sum(c(avg_client_responses[[1]][1:length(allStripsPricelist[[i]])])))
  averaged_prices <- append(averaged_prices, frac)
}
fraction_prices <- Map('*', averaged_prices, allStripsPricelist)
averaged_prices <- list()
for(i in 1:length(fraction_prices)){
  averaged_prices <- append(averaged_prices, sum(fraction_prices[[i]]))
}
averaged_prices <- c(sapply(averaged_prices, '[', i=1))
contractndates <- list(Date=pat_output[pat_output$Recommendation=="5 - Great hedging opportunity" | pat_output$Recommendation=="4 - Very good hedging opportunity", "Date"], Contract=pat_output[pat_output$Recommendation=="5 - Great hedging opportunity" | pat_output$Recommendation=="4 - Very good hedging opportunity", "Contract"])
dates <- contractndates$Date
contracts <- contractndates$Contract
averaged_prices <- data.frame(Contract=contracts, Date=dates, Price=averaged_prices)
pat_output_modified <- pat_output
pat_mod_index <- which(outer(pat_output_modified$Contract, averaged_prices$Contract, "==")                      & outer(pat_output_modified$Date, averaged_prices$Date, "=="),
                       arr.ind = TRUE)
for (idx in 1:nrow(pat_mod_index)){
  pat_output_modified$Price[pat_mod_index[idx,"row"]] <- averaged_prices$Price[idx]
}
pat_output_modified <- pat_output_modified[order(pat_output_modified$Contract), ]
modified_Y_14AM <- pat_output_modified[pat_output_modified$Contract=="Y_14AM",]
modified_Y_15 <- pat_output_modified[pat_output_modified$Contract=="Y_15",]
modified_Y_15AM <- pat_output_modified[pat_output_modified$Contract=="Y_15AM",]
modified_Y_16 <- pat_output_modified[pat_output_modified$Contract=="Y_16",]
modified_Y_16AM <- pat_output_modified[pat_output_modified$Contract=="Y_16AM",]
modified_Y_17 <- pat_output_modified[pat_output_modified$Contract=="Y_17",]
modified_Y_17AM <- pat_output_modified[pat_output_modified$Contract=="Y_17AM",]

Violin plots showing weighted average prices for Great & V. Good hedging opportunities taking future 28 days as client responses/ delays into consideration. A red dot represents “5 - Great hedging opportunity” and a yellow dot represents “4 - Very good hedging opportunity”. Horizontal crossbar(black) shows the median price for that strip.

ggplot(width = 950, pat_output_modified, aes(Contract, Price)) + geom_violin(aes(fill = Contract)) + scale_fill_manual(values=c("#B4E0D2", "#FCC6B3", "#C6CFE4", "#F2C5E0", "#D3EAAD", "#FEEBA1", "#F1E1CA")) + geom_point(data=pat_output[pat_output$Recommendation=="5 - Great hedging opportunity",], aes(Contract, Price), color = "#B40619", position = position_jitter(0.09), size = 0.5) + geom_point(data=pat_output[pat_output$Recommendation=="4 - Very good hedging opportunity",], aes(Contract, Price), color = "#E56621", position = position_jitter(0.09), size = 0.5) + stat_summary(fun.y = "median", fun.ymin ="median", fun.ymax ="median", geom ="crossbar", width=0.2, fatten = 1)

The plot doesn’t look very different from previous the violin plot or the changes are insignificant to be visible at high level.

Basic statistics with weighted prices for Great & V. Good hedging Prices.

year_strips <- list(modified_Y_14AM, modified_Y_15, modified_Y_15AM, modified_Y_16, modified_Y_16AM, modified_Y_17, modified_Y_17AM)
fraction <- function(strip){
  yearOrderedByPrice <- strip[order(-strip$Price),]
  first_quartile <- yearOrderedByPrice[c(1:trunc(nrow(yearOrderedByPrice)/4)),]
  second_quartile <- yearOrderedByPrice[c((trunc(nrow(yearOrderedByPrice)/4)+1):trunc(nrow(yearOrderedByPrice)/2)),]
  third_quartile <- yearOrderedByPrice[c((trunc(nrow(yearOrderedByPrice)/2)+1):trunc(nrow(yearOrderedByPrice)*3/4)),]
  fourth_quartile <- yearOrderedByPrice[c((trunc(nrow(yearOrderedByPrice)*3/4)+1):trunc(nrow(yearOrderedByPrice))),]
  
  numOfGreatInFirstQuartile <- sum(first_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInFirstQuartile <- sum(first_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfGreatInSecondQuartile <- sum(second_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInSecondQuartile <- sum(second_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfGreatInThirdQuartile <- sum(third_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInThirdQuartile <- sum(third_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfGreatInFourthQuartile <- sum(fourth_quartile$Recommendation == "5 - Great hedging opportunity")
  numOfVeryGoodInFourthQuartile <- sum(fourth_quartile$Recommendation == "4 - Very good hedging opportunity")
  numOfOppInFirstQuartile <- numOfGreatInFirstQuartile + numOfVeryGoodInFirstQuartile
  numOfOppInSecondQuartile <- numOfGreatInSecondQuartile + numOfVeryGoodInSecondQuartile
  numOfOppInThirdQuartile <- numOfGreatInThirdQuartile + numOfVeryGoodInThirdQuartile
  numOfOppInFourthQuartile <- numOfGreatInFourthQuartile + numOfVeryGoodInFourthQuartile
  cat("Total no. of Great or V. Good hedging opportunities for the strip",strip$Contract[1],":",numOfOppInFirstQuartile + numOfOppInSecondQuartile + numOfOppInThirdQuartile + numOfOppInFourthQuartile, "\n" )
  cat("No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip",strip$Contract[1],":",numOfOppInFirstQuartile, "\n")
  cat("No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip",strip$Contract[1],":",numOfOppInSecondQuartile, "\n")
  cat("No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip",strip$Contract[1],":",numOfOppInThirdQuartile, "\n")
  cat("No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip",strip$Contract[1],":",numOfOppInFourthQuartile, "\n\n")
  
}
for(i in year_strips){
  fraction(i)
}

Total no. of Great or V. Good hedging opportunities for the strip Y_14AM : 5 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_14AM : 2 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_14AM : 3 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_14AM : 0 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_14AM : 0 

Total no. of Great or V. Good hedging opportunities for the strip Y_15 : 12 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_15 : 0 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_15 : 0 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_15 : 5 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_15 : 7 

Total no. of Great or V. Good hedging opportunities for the strip Y_15AM : 10 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_15AM : 3 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_15AM : 0 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_15AM : 0 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_15AM : 7 

Total no. of Great or V. Good hedging opportunities for the strip Y_16 : 68 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_16 : 7 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_16 : 29 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_16 : 6 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_16 : 26 

Total no. of Great or V. Good hedging opportunities for the strip Y_16AM : 66 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_16AM : 2 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_16AM : 34 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_16AM : 16 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_16AM : 14 

Total no. of Great or V. Good hedging opportunities for the strip Y_17 : 47 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_17 : 10 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_17 : 13 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_17 : 6 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_17 : 18 

Total no. of Great or V. Good hedging opportunities for the strip Y_17AM : 69 
No. of Great or V. Good hedging opportunities in the top quarter(0-25%, first quartile) prices for the strip Y_17AM : 20 
No. of Great or V. Good hedging opportunities in the next quarter(25%-50%, second quartile) prices for the strip Y_17AM : 11 
No. of Great or V. Good hedging opportunities in the next quarter(50%-75%, third quartile) prices for the strip Y_17AM : 8 
No. of Great or V. Good hedging opportunities in the bottom quarter(75%-100%, fourth quartile) prices for the strip Y_17AM : 30 

Relative bar plot showing the difference between weighted average prices for hedging opportunities Vs. actual prices on the day of Great or V. Good hedging opportunities.

modified_opp <- pat_output_modified[pat_output_modified$Recommendation=="5 - Great hedging opportunity" | pat_output_modified$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp <- pat_output[pat_output$Recommendation=="5 - Great hedging opportunity" |
                    pat_output$Recommendation=="4 - Very good hedging opportunity", "Price"]
x <- pat_output[pat_output$Recommendation=="5 - Great hedging opportunity" | pat_output$Recommendation=="4 - Very good hedging opportunity", "Date"]
y <- unlist(Map('-', modified_opp, opp))
data <- data.frame(x, y)
plot_ly(data, x = ~x, y = ~y, type = 'bar', width = 950) %>% layout(hovermode="compare", 
         title = 'Overview of modified effective hedging opportunity prices',
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference(effective - actual)'))

lower_prices <- sum(y<0)
higher_prices <- sum(y>0)
unchanged_prices <- sum(y==0)
percent_lower_price <- 100*lower_prices/nrow(averaged_prices)
percent_higher_price <- 100*higher_prices/nrow(averaged_prices)
percent_same_price <- 100*unchanged_prices/nrow(averaged_prices)
cat("Weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price,"%\nWeighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price, "%\nWeighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price,"%\n\n")

Weighted average great & very good hedging opportunity prices that are lower than the actual prices 43.68231 %
Weighted average great & very good hedging opportunity prices that are higher than the actual prices 55.59567 %
Weighted average great & very good hedging opportunity prices that are same as the actual prices 0.7220217 %

Relative bar plot showing the difference between weighted average prices for hedging opportunities Vs. actual prices on the day of Great or V. Good hedging opportunities for each strip.

modified_opp_Y_14AM <- modified_Y_14AM[modified_Y_14AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_14AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_14AM <- Y_14AM[Y_14AM$Recommendation=="5 - Great hedging opportunity" |
                    Y_14AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_14AM <- modified_Y_14AM[modified_Y_14AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_14AM$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_14AM <- unlist(Map('-', modified_opp_Y_14AM, opp_Y_14AM))
data_Y_14AM <- data.frame(x_Y_14AM, y_Y_14AM)
p1 <- plot_ly(data, x = ~x_Y_14AM, y = ~y_Y_14AM, type = 'bar', name = 'Y_14AM', width = 950, height = 650) %>% layout(hovermode="compare", xaxis = list(title = 'Dates'), yaxis = list(title = 'Difference'))
modified_opp_Y_15 <- modified_Y_15[modified_Y_15$Recommendation=="5 - Great hedging opportunity" | modified_Y_15$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_15 <- Y_15[Y_15$Recommendation=="5 - Great hedging opportunity" |
                    Y_15$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_15 <- modified_Y_15[modified_Y_15$Recommendation=="5 - Great hedging opportunity" | modified_Y_15$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_15 <- unlist(Map('-', modified_opp_Y_15, opp_Y_15))
data_Y_15 <- data.frame(x_Y_15, y_Y_15)
p2 <- plot_ly(data, x = ~x_Y_15, y = ~y_Y_15, type = 'bar', name = 'Y_15', width = 950) %>% layout(hovermode="compare", 
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference'))
modified_opp_Y_15AM <- modified_Y_15AM[modified_Y_15AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_15AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_15AM <- Y_15AM[Y_15AM$Recommendation=="5 - Great hedging opportunity" |
                    Y_15AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_15AM <- modified_Y_15AM[modified_Y_15AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_15AM$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_15AM <- unlist(Map('-', modified_opp_Y_15AM, opp_Y_15AM))
data_Y_15AM <- data.frame(x_Y_15AM, y_Y_15AM)
p3 <- plot_ly(data, x = ~x_Y_15AM, y = ~y_Y_15AM, type = 'bar', name = 'Y_15AM', width = 950) %>% layout(hovermode="compare", 
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference'))
modified_opp_Y_16 <- modified_Y_16[modified_Y_16$Recommendation=="5 - Great hedging opportunity" | modified_Y_16$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_16 <- Y_16[Y_16$Recommendation=="5 - Great hedging opportunity" |
                    Y_16$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_16 <- modified_Y_16[modified_Y_16$Recommendation=="5 - Great hedging opportunity" | modified_Y_16$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_16 <- unlist(Map('-', modified_opp_Y_16, opp_Y_16))
data_Y_16 <- data.frame(x_Y_16, y_Y_16)
p4 <- plot_ly(data, x = ~x_Y_16, y = ~y_Y_16, type = 'bar', name = 'Y_16', width = 950) %>% layout(hovermode="compare", 
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference'))
modified_opp_Y_16AM <- modified_Y_16AM[modified_Y_16AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_16AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_16AM <- Y_16AM[Y_16AM$Recommendation=="5 - Great hedging opportunity" |
                    Y_16AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_16AM <- modified_Y_16AM[modified_Y_16AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_16AM$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_16AM <- unlist(Map('-', modified_opp_Y_16AM, opp_Y_16AM))
data_Y_16AM <- data.frame(x_Y_16AM, y_Y_16AM)
p5 <- plot_ly(data, x = ~x_Y_16AM, y = ~y_Y_16AM, type = 'bar', name = 'Y_16AM', width = 950) %>% layout(hovermode="compare", 
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference'))
modified_opp_Y_17 <- modified_Y_17[modified_Y_17$Recommendation=="5 - Great hedging opportunity" | modified_Y_17$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_17 <- Y_17[Y_17$Recommendation=="5 - Great hedging opportunity" |
                    Y_17$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_17 <- modified_Y_17[modified_Y_17$Recommendation=="5 - Great hedging opportunity" | modified_Y_17$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_17 <- unlist(Map('-', modified_opp_Y_17, opp_Y_17))
data_Y_17 <- data.frame(x_Y_17, y_Y_17)
p6 <- plot_ly(data, x = ~x_Y_17, y = ~y_Y_17, type = 'bar', name = 'Y_17', width = 950) %>% layout(hovermode="compare", 
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference'))
modified_opp_Y_17AM <- modified_Y_17AM[modified_Y_17AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_17AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
opp_Y_17AM <- Y_17AM[Y_17AM$Recommendation=="5 - Great hedging opportunity" |
                    Y_17AM$Recommendation=="4 - Very good hedging opportunity", "Price"]
x_Y_17AM <- modified_Y_17AM[modified_Y_17AM$Recommendation=="5 - Great hedging opportunity" | modified_Y_17AM$Recommendation=="4 - Very good hedging opportunity", "Date"]
y_Y_17AM <- unlist(Map('-', modified_opp_Y_17AM, opp_Y_17AM))
data_Y_17AM <- data.frame(x_Y_17AM, y_Y_17AM)
p7 <- plot_ly(data, x = ~x_Y_17AM, y = ~y_Y_17AM, type = 'bar', name = 'Y_17AM', width = 950) %>% layout(hovermode="compare", 
         xaxis = list(title = 'Dates'),
         yaxis = list(title = 'Difference'))
subplot(p1, p2, p3, p4, p5, p6, p7, nrows = 4, shareY = TRUE)

lower_prices_Y_14AM <- sum(y_Y_14AM<0)
higher_prices_Y_14AM <- sum(y_Y_14AM>0)
unchanged_prices_Y_14AM <- sum(y_Y_14AM==0)
percent_lower_price_Y_14AM <- 100*lower_prices_Y_14AM/length(Y_14AM[Y_14AM$Recommendation=="5 - Great hedging opportunity" | Y_14AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_14AM <- 100*higher_prices_Y_14AM/length(Y_14AM[Y_14AM$Recommendation=="5 - Great hedging opportunity" | Y_14AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_14AM <- 100*unchanged_prices_Y_14AM/length(Y_14AM[Y_14AM$Recommendation=="5 - Great hedging opportunity" | Y_14AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_14AM weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_14AM,"%\nFor the strip Y_14AM weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_14AM, "%\nFor the strip Y_14AM weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_14AM,"%\n\n")

For the strip Y_14AM weighted average great & very good hedging opportunity prices that are lower than the actual prices 20 %
For the strip Y_14AM weighted average great & very good hedging opportunity prices that are higher than the actual prices 60 %
For the strip Y_14AM weighted average great & very good hedging opportunity prices that are same as the actual prices 20 %

lower_prices_Y_15 <- sum(y_Y_15<0)
higher_prices_Y_15 <- sum(y_Y_15>0)
unchanged_prices_Y_15 <- sum(y_Y_15==0)
percent_lower_price_Y_15 <- 100*lower_prices_Y_15/length(Y_15[Y_15$Recommendation=="5 - Great hedging opportunity" | Y_15$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_15 <- 100*higher_prices_Y_15/length(Y_15[Y_15$Recommendation=="5 - Great hedging opportunity" | Y_15$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_15 <- 100*unchanged_prices_Y_15/length(Y_15[Y_15$Recommendation=="5 - Great hedging opportunity" | Y_15$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_15 weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_15,"%\nFor the strip Y_15 weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_15, "%\nFor the strip Y_15 weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_15,"%\n\n")

For the strip Y_15 weighted average great & very good hedging opportunity prices that are lower than the actual prices 8.333333 %
For the strip Y_15 weighted average great & very good hedging opportunity prices that are higher than the actual prices 83.33333 %
For the strip Y_15 weighted average great & very good hedging opportunity prices that are same as the actual prices 8.333333 %

lower_prices_Y_15AM <- sum(y_Y_15AM<0)
higher_prices_Y_15AM <- sum(y_Y_15AM>0)
unchanged_prices_Y_15AM <- sum(y_Y_15AM==0)
percent_lower_price_Y_15AM <- 100*lower_prices_Y_15AM/length(Y_15AM[Y_15AM$Recommendation=="5 - Great hedging opportunity" | Y_15AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_15AM <- 100*higher_prices_Y_15AM/length(Y_15AM[Y_15AM$Recommendation=="5 - Great hedging opportunity" | Y_15AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_15AM <- 100*unchanged_prices_Y_15AM/length(Y_15AM[Y_15AM$Recommendation=="5 - Great hedging opportunity" | Y_15AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_15AM weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_15AM,"%\nFor the strip Y_15AM weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_15AM, "%\nFor the strip Y_15AM weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_15AM,"%\n\n")

For the strip Y_15AM weighted average great & very good hedging opportunity prices that are lower than the actual prices 30 %
For the strip Y_15AM weighted average great & very good hedging opportunity prices that are higher than the actual prices 70 %
For the strip Y_15AM weighted average great & very good hedging opportunity prices that are same as the actual prices 0 %

lower_prices_Y_16 <- sum(y_Y_16<0)
higher_prices_Y_16 <- sum(y_Y_16>0)
unchanged_prices_Y_16 <- sum(y_Y_16==0)
percent_lower_price_Y_16 <- 100*lower_prices_Y_16/length(Y_16[Y_16$Recommendation=="5 - Great hedging opportunity" | Y_16$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_16 <- 100*higher_prices_Y_16/length(Y_16[Y_16$Recommendation=="5 - Great hedging opportunity" | Y_16$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_16 <- 100*unchanged_prices_Y_16/length(Y_16[Y_16$Recommendation=="5 - Great hedging opportunity" | Y_16$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_16 weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_16,"%\nFor the strip Y_16 weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_16, "%\nFor the strip Y_16 weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_16,"%\n\n")

For the strip Y_16 weighted average great & very good hedging opportunity prices that are lower than the actual prices 70.58824 %
For the strip Y_16 weighted average great & very good hedging opportunity prices that are higher than the actual prices 29.41176 %
For the strip Y_16 weighted average great & very good hedging opportunity prices that are same as the actual prices 0 %

lower_prices_Y_16AM <- sum(y_Y_16AM<0)
higher_prices_Y_16AM <- sum(y_Y_16AM>0)
unchanged_prices_Y_16AM <- sum(y_Y_16AM==0)
percent_lower_price_Y_16AM <- 100*lower_prices_Y_16AM/length(Y_16AM[Y_16AM$Recommendation=="5 - Great hedging opportunity" | Y_16AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_16AM <- 100*higher_prices_Y_16AM/length(Y_16AM[Y_16AM$Recommendation=="5 - Great hedging opportunity" | Y_16AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_16AM <- 100*unchanged_prices_Y_16AM/length(Y_16AM[Y_16AM$Recommendation=="5 - Great hedging opportunity" | Y_16AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_16AM weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_16AM,"%\nFor the strip Y_16AM weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_16AM, "%\nFor the strip Y_16AM weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_16AM,"%\n\n")

For the strip Y_16AM weighted average great & very good hedging opportunity prices that are lower than the actual prices 42.42424 %
For the strip Y_16AM weighted average great & very good hedging opportunity prices that are higher than the actual prices 57.57576 %
For the strip Y_16AM weighted average great & very good hedging opportunity prices that are same as the actual prices 0 %

lower_prices_Y_17 <- sum(y_Y_17<0)
higher_prices_Y_17 <- sum(y_Y_17>0)
unchanged_prices_Y_17 <- sum(y_Y_17==0)
percent_lower_price_Y_17 <- 100*lower_prices_Y_17/length(Y_17[Y_17$Recommendation=="5 - Great hedging opportunity" | Y_17$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_17 <- 100*higher_prices_Y_17/length(Y_17[Y_17$Recommendation=="5 - Great hedging opportunity" | Y_17$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_17 <- 100*unchanged_prices_Y_17/length(Y_17[Y_17$Recommendation=="5 - Great hedging opportunity" | Y_17$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_17 weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_17,"%\nFor the strip Y_17 weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_17, "%\nFor the strip Y_17 weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_17,"%\n\n")

For the strip Y_17 weighted average great & very good hedging opportunity prices that are lower than the actual prices 40.42553 %
For the strip Y_17 weighted average great & very good hedging opportunity prices that are higher than the actual prices 59.57447 %
For the strip Y_17 weighted average great & very good hedging opportunity prices that are same as the actual prices 0 %

lower_prices_Y_17AM <- sum(y_Y_17AM<0)
higher_prices_Y_17AM <- sum(y_Y_17AM>0)
unchanged_prices_Y_17AM <- sum(y_Y_17AM==0)
percent_lower_price_Y_17AM <- 100*lower_prices_Y_17AM/length(Y_17AM[Y_17AM$Recommendation=="5 - Great hedging opportunity" | Y_17AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_higher_price_Y_17AM <- 100*higher_prices_Y_17AM/length(Y_17AM[Y_17AM$Recommendation=="5 - Great hedging opportunity" | Y_17AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
percent_same_price_Y_17AM <- 100*unchanged_prices_Y_17AM/length(Y_17AM[Y_17AM$Recommendation=="5 - Great hedging opportunity" | Y_17AM$Recommendation=="4 - Very good hedging opportunity", "Price"])
cat("For the strip Y_17AM weighted average great & very good hedging opportunity prices that are lower than the actual prices",percent_lower_price_Y_17AM,"%\nFor the strip Y_17AM weighted average great & very good hedging opportunity prices that are higher than the actual prices", percent_higher_price_Y_17AM, "%\nFor the strip Y_17AM weighted average great & very good hedging opportunity prices that are same as the actual prices",percent_same_price_Y_17AM,"%\n\n")

For the strip Y_17AM weighted average great & very good hedging opportunity prices that are lower than the actual prices 30.43478 %
For the strip Y_17AM weighted average great & very good hedging opportunity prices that are higher than the actual prices 69.56522 %
For the strip Y_17AM weighted average great & very good hedging opportunity prices that are same as the actual prices 0 %

2) Averaged over average of each year: Number of client responses for each date of a particular year are averaged to get an yearly average which are then summed together and divided by total number of client responses averaged over each year.

\[ Average\,client\,responses\,on\,\,k^{th}\,\,day\,= \frac{\sum(Year\,average\,client\,responses\,on\,k^{th}\,day)}{\sum(Number\,of\,average\,client\, responses\, for\, each\, year)} \]

Since there isn’t much of a difference in the averaged outputs from both approaches, we used only the \(1^{st}\) approach.

Are the differences between the effective averaged prices and actual prices really significant?

To evaluate the significance we do a significance test with